home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / dev / amos / TSL_source.lha / TSL.AMOS / TSL.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1997-08-19  |  10.2 KB  |  311 lines
  1. Set Buffer 300
  2. TSL=6000
  3. Dim SONGS$(TSL),SELECT(TSL)
  4. Global SONGS$(),SELECT(),TSL,SONG,V$,OLD$,MOV,R,SPR,SOA,STS,SEL,NT,MNT
  5. MAIN
  6. '
  7. Procedure MAIN
  8.    If Ntsc=0 Then NT=20 : MNT=250 Else NT=15 : MNT=210
  9.    Unpack 6 To 6 : Screen Hide 6 : Auto View Off 
  10.    Screen Open 0,704,264,8,Hires
  11.    For I=0 To 15 : Colour I,0 : Next 
  12.    Screen Display 0,120,,,
  13.    Flash Off : Curs Off : Paper 0 : Cls 0 : Hide : Palette ,,,$F0F
  14.    Set Rainbow 0,0,16,"","(1,1,9)(1,-1,10)",""
  15.    For I=0 To 15 : Colour I,0 : Next 
  16.    Screen 0
  17.    Screen Copy 6 To 0
  18.    Auto View On : View 
  19.    Fade 3 To 6
  20.    Locate 4,2 : Print "Loading songs..."
  21.    If NT=20 Then Screen Copy 6,0,66,704,70 To 0,0,250
  22.    If NT=15 Then Screen Copy 6,0,66,704,70 To 0,0,210
  23.    Cls 0,560,30 To 670,45
  24.    Screen Copy 6,590,30,620,45 To 0,560,30
  25.    Auto View On 
  26.    FILE$="TSList"
  27.    Open In 1,FILE$
  28.    Set Input 10,-1
  29.    Set Tab 8
  30.    Pen 3
  31.    SONG=1 : SEL=0 : OLD$="" : STS=0
  32.    While Not Eof(1)
  33.       Locate 21,2 : Print SONG;
  34.       Line Input #1,SONGS$(SONG)
  35.       Inc SONG
  36.    Wend 
  37.    Close 1
  38.    Pen 2 : Locate 4,2 : Print "Sorting Songs..." : Sort SONGS$(1)
  39.    Locate 4,2 : Print "Songs :"; : Pen 3 : Print SONG-1;Space$(11)
  40.    Pen 2
  41.    Locate 30,2 : Print "Select :"
  42.    Locate 61,2 : Print "Position :"
  43.    OLDI=TSL-SONG+2 : OLDL=1 : R=1 : SPR=0 : SOA=33
  44.    MENU:
  45.    Pen 2 : Locate ,11 : Centre "Instuctions" : Print 
  46.    Centre "-------------" : Pen 3 : Print : Print 
  47.    Centre "Press F1 to display the full list" : Print : If NT=20 Then Print 
  48.    Centre "Then use cursor keys to move." : Print 
  49.    Centre "Up - Down:  -1 +1   Left - Right:  -20 +20" : Print : Print 
  50.    Centre "'s' to search" : Print 
  51.    Centre "'e' to edit  " : Print 
  52.    Centre "'i' to insert" : Print 
  53.    Centre "'space' to select a song" : Print : Print 
  54.    Centre "F3 tongles search between Full / Songs only" : Print : If NT=20 Then Print 
  55.    If NT=20 Then Centre "In edit/insert F1-F2 tongles between USA/Greek keymaps"
  56.    Locate ,NT+10 : Centre "(c) 1993-96 Alexis Katsadorakis  <melody@compulink.gr>"
  57.    Repeat 
  58.       Do : I$=Inkey$ : K=Scancode : Exit If K<>0 : Loop 
  59.       If K=80 Then Goto P_ALL
  60.       If K=81 Then Goto PR_SONGS
  61.       If K=82 Then SONG_OR_ALL
  62.       If K=83 Then PR_ON_OFF
  63.       If K=88 Then For I=1 To TSL : SELECT(I)=0 : Next : SEL=0 : Pen 3 : Locate 38,2 : Print SEL;"    "
  64.    If K=95 Then Show On : Read Text "TSL.doc" : Hide On 
  65.    Until K=69 or K=84
  66.    If K=84
  67.       Sort SONGS$(1)
  68.       Pen 2 : Locate 4,2 : Print "Saving songs...";Space$(64) : Pen 3
  69.       Open Out 1,FILE$
  70.       For I=TSL-SONG+2 To TSL
  71.          Locate 21,2 : Print Using "####";TSL-I
  72.          Print #1,SONGS$(I);Chr$(10);
  73.       Next 
  74.    End If 
  75.    Fade 3 : Wait 40
  76.    Close 
  77.    End 
  78.    P_ALL:
  79.    LA=1 : L=OLDL
  80.    I=OLDI
  81.    Cls 0,0,88 To 690,MNT
  82.    Do : MA=0 : For I=I To I+NT
  83.          Gosub CH2 : If K=69 Then Goto EX1
  84.          If SELECT(L)=1 Then Pen 3 Else Pen 2
  85.          Locate 2,10+LA : Print Using "####";L,SONGS$(I);
  86.          Inc LA : Inc L
  87.          If LA=NT+1 Then MA=NT+1 : MA2=NT : Gosub CH1 : LA=1 : Cls 0,0,88 To 690,MNT
  88.          If K=69 Then Goto EX1
  89.       Next 
  90.    Loop 
  91.    EX1:
  92.    K=0
  93.    If LA<>1 Then OLDL=L-LA+1 : OLDI=I-LA+1
  94.    Locate 71,2 : Print Space$(12)
  95.    If LA=1 Then OLDL=L-NT : OLDI=I-NT+1
  96.    Rainbow 0,,0,0 : Goto MENU
  97.    Return 
  98.    CH1: Rainbow 0,,116+(R*8),16 : Channel 1 To Rainbow 0
  99.    I1: I$=Inkey$ : K=Scancode
  100.    SO=R+L-MA
  101.    If K=77 and R<LA-1 Then R=R+1 : Amal 1,"M 0,8,4" : Amal On 1 : Wait 4
  102.    If K=76 and R>1 Then R=R-1 : Amal 1,"M 0,-8,4" : Amal On 1 : Wait 4
  103.    If K=78 Then R=1 : Return 
  104.    If K=33 Then SEARCH[R] : Clear Key : K=0
  105.    If K=79 and L>(NT*2) Then Add I,-(NT*2) : Add L,-(NT*2) : R=1 : Return 
  106.    If K=61 Then R=1 : Cls 0,0,88 To 690,MNT : Goto P_ALL
  107.    If K=68 or K=64 Then Gosub SELECT : Pen 3 : Locate 38,2 : Print SEL;"   "
  108.    If K=89 Then STS=Abs(STS-1)
  109.    If K=69 Then Return 
  110.    If K=18 Then Gosub SONG_EDIT
  111.    If K=23 Then Gosub INSERT : Goto P_ALL
  112.    If K=82 Then SONG_OR_ALL
  113.    If K=83 Then PR_ON_OFF
  114.    If K=95 Then Show On : Read Text "TSL.doc" : Hide On 
  115.    Locate 71,2 : Pen 3 : Print SO;"  ";(100*SO)/SONG;"%   ";
  116.    Goto I1
  117.    SELECT:
  118.    If SELECT(SO)=0
  119.       Pen 3 : Locate 2,10+R : Print Using "####";SO,SONGS$(I-MA2+R);
  120.       Inc SEL : SELECT(SO)=1 : Return 
  121.    End If 
  122.    If SELECT(SO)=1
  123.       Pen 2 : Locate 2,10+R : Print Using "####";SO,SONGS$(I-MA2+R);
  124.       Add SEL,-1 : SELECT(SO)=0
  125.    End If 
  126.    Return 
  127.    CH2: If I=TSL+1 Then MA=LA : MA2=LA : Gosub CH1 : Else Return 
  128.    If K=69 Then Cls 0,0,88 To 690,MNT : Return 
  129.    If I>TSL Then Goto CH2
  130.    If I<TSL+1 Then I=I-LA+NT+1 : L=L-LA+NT+1 : Cls 0,0,88 To 690,MNT : LA=1 : Goto CH2
  131.    '
  132.    '
  133.    PR_SONGS:
  134.    Pen 3 : Locate ,9 : Centre "Enter = Screen  -  'P' = Printer"
  135.    Cls 0,0,88 To 690,MNT
  136.    TAKE: I$=Inkey$ : If I$="p" or I$="P" Then Goto LPR_SONGS
  137.    If I$<>Chr$(13) Then Goto TAKE
  138.    Locate 1,9 : Print Space$(80)
  139.    LA=1 : L=1 : P=0
  140.    Pen 2
  141.    For I=1 To SONG-1
  142.       If SELECT(I)=1
  143.          Locate 2,10+L : Print Using "####";LA,SONGS$(TSL-SONG+1+I) : P=1
  144.          Inc LA : Inc L
  145.       End If 
  146.       If L=NT+1 Then Wait Key : Cls 0,0,88 To 690,MNT : L=1
  147.    Next 
  148.    If P=1 Then Wait Key : Cls 0,0,88 To 690,MNT
  149.    Goto MENU
  150.    '
  151.    LPR_SONGS:
  152.    Locate 1,9 : Print Space$(80)
  153.    P=0 : LA=1 : L=1
  154.    For I=1 To SONG-1
  155.       If SELECT(I)=1
  156.          Lprint Using "####";LA;"  ";SONGS$(TSL-SONG+1+I) : P=1
  157.          Inc LA : Inc L
  158.       End If 
  159.       If L=60 Then Lprint Chr$(12) : L=1
  160.    Next 
  161.    If P=1 Then Lprint Chr$(12)
  162.    Goto MENU
  163.    SONG_EDIT:
  164.    V$=SONGS$(I-MA2+R)
  165.    M_INPUT[8,10+R,77,V$,3]
  166.    Locate 8,10+R : Pen 2 : Print V$;
  167.    SONGS$(I-MA2+R)=V$
  168.    Return 
  169.    '
  170.    INSERT:
  171.    Screen Open 1,690,23,8,Hires
  172.    If NT=15 Then LL=178 Else LL=194
  173.    Screen Display 1,120,LL,,
  174.    Flash Off : Curs Off : Paper 0 : Cls 0 : Get Palette 0
  175.    Repeat 
  176.       M_INPUT[8,1,77,"",3]
  177.       If MOV<>27 Then Inc SONG : SONGS$(TSL-1-SONG+2)=V$
  178.    Until MOV=27
  179.    Screen Close 1
  180.    Pen 2 : Locate 4,2 : Print "Sorting Songs..." : Sort SONGS$(1)
  181.    Locate 4,2 : Print "Songs :"; : Pen 3 : Print SONG-1;Space$(10)
  182.    Pen 2
  183.    OLDI=TSL-SONG+2 : OLDL=1 : R=1 : SPR=0
  184.    Cls 0,0,88 To 690,MNT
  185.    Return 
  186. End Proc
  187. '
  188. Procedure PR_ON_OFF
  189.    If SPR=0 Then SPR=1 : LS=562 : ES=590 Else SPR=0 : LS=590 : ES=620
  190.    Screen Copy 6,LS,30,ES,45 To 0,560,30
  191. End Proc
  192. '
  193. Procedure SONG_OR_ALL
  194. If SOA=33 Then SOA=1 : LS=630 : ES=668 : YY=30 Else SOA=33 : LS=188 : ES=230 : YY=53
  195.    Screen Copy 6,LS,YY,ES,YY+13 To 0,188,53
  196. End Proc
  197. '
  198. Procedure SEARCH[R]
  199.    Rainbow 0,,350,16
  200.    Locate 18,9 : Print "Enter String : [";Space$(32);"]"
  201.    V$=OLD$ : M_INPUT[35,9,30,V$,5]
  202.    Locate 18,9 : Print Space$(50)
  203.    If MOV=27 Then Goto EX2
  204.    OLD$=V$
  205.    V$=Upper$(V$)
  206.    Screen Open 1,690,MNT+6,4,Hires
  207.    Screen Display 1,,-242,,
  208.    Set Tab 8
  209.    Get Palette 0
  210.    Flash Off : Curs Off : Paper 0 : Pen 2 : Cls 0
  211.    P=0 : LA=1 : LLA=0 : T=0
  212.    Pen 3
  213.    A$="  Searching for ("+OLD$+")  " : Locate 0,0 : Centre A$ : Pen 2
  214.    LV=Len(V$)
  215.    I=1
  216.    If SPR=1 Then T=1 : Gosub SH_SC
  217.    Repeat 
  218.       I$=Inkey$ : K=Scancode : If K=69 Then Screen Close 1 : Goto EX2
  219.       V1$=Upper$(SONGS$(TSL-SONG+1+I))
  220.       LV1=Len(V1$)
  221.       For J=SOA To LV1-LV+1
  222.          If V$=Mid$(V1$,J,LV) Then Gosub PR_V : Exit 
  223.       Next 
  224.       If LA=NT+11 and T=0 Then LA=1 : T=1 : Gosub SH_SC : Gosub WKEY : Cls 0,0,8 To 690,MNT-2
  225.       If LA=NT+11 and T=1 Then LA=1 : Gosub WKEY : Cls 0,0,8 To 690,MNT-2
  226.       Inc I
  227.    Until I=SONG
  228.    If P=1 Then A$="  End of search - Press any key  - "+Str$(LLA)+" songs  " Else Goto EX1
  229.    Locate 0,NT+11 : Pen 3 : Centre A$
  230.    If T=0 Then Gosub SC1
  231.    Wait Key 
  232.    EX3:
  233.    For I=42 To -242 Step -10 : Screen Display 1,,I,, : Wait Vbl : Next 
  234.    Screen Close 1
  235.    If STS=1 Then Pen 3 : Locate 38,2 : Print SEL;"   "
  236.    If SPR=1 Then Lprint Chr$(12)
  237.    EX1:
  238.    If P=0 Then Screen Close 1 : Locate ,9 : Pen 5 : Centre "String not found" : Wait 100 : Locate 0,9 : Print Space$(80)
  239.    EX2: Rainbow 0,,116+(R*8),16 : Pop Proc
  240.    PR_V:
  241.    If SPR=1
  242.       Lprint SONGS$(TSL-SONG+1+I)
  243.    End If 
  244.    Locate 0,LA : Print Using "######";I,SONGS$(TSL-SONG+1+I);
  245.    If STS=1 Then SELECT(I)=1 : Inc SEL
  246.    P=1 : Inc LA : Inc LLA
  247.    Return 
  248.    '
  249.    SH_SC:
  250.    Locate 0,NT+11 : Pen 3 : Centre "  Press any key  " : Pen 2
  251.    SC1: For E=-242 To 42 Step 10 : Screen Display 1,,E,, : Wait Vbl : Next E
  252.    Screen Display 1,,42,,
  253.    Return 
  254.    '
  255.    WKEY:
  256.    If SPR=1 Then Return 
  257.    I$=Inkey$ : K=Scancode : If I$="" Then Goto WKEY
  258.    If K=69 Then Goto EX3 Else Return 
  259. End Proc
  260. '
  261. Procedure M_INPUT[N,M,MX,V$,P]
  262. T=N-1 : N1=N : N=N+Len(V$) : V$=V$+Space$(MX+1-Len(V$)) : MOV=0
  263. Pen P : Paper 0 : Locate N1,M : Print V$;
  264. GRFLASH:
  265. Pen P
  266. NCHAR:
  267.   Locate N,M : Paper 4+GR : Print Mid$(V$,N-N1+1,1); : Paper 0
  268.   Repeat 
  269.     I$=Inkey$ : K=Scancode
  270.   Until I$<>""
  271.   If K=82 Then SONG_OR_ALL
  272.   If K=83 Then PR_ON_OFF
  273.   If K=89 Then STS=Abs(STS-1)
  274.   If K=79 and N>N1 Then Paper 0 : Locate N,M : Print Mid$(V$,N-N1+1,1); : N=N-1
  275.   If K=78 and N<N1+MX Then Paper 0 : Locate N,M : Print Mid$(V$,N-N1+1,1); : Inc N
  276.   If K=81 Then GR=1 : Goto GRFLASH Else If K=80 Then GR=0 : Goto GRFLASH
  277.   I=Asc(I$) : If K=68 and N>T Then Goto GO Else If K=69 Then Goto ESC
  278.   Locate N-1,M : If K=65 and N>N1 Then Print " ";Mid$(V$,N-N1+1,1); : N=N-1 : Mid$(V$,N-N1+1,1)=" " : Goto NCHAR
  279.   If I<32 Then Goto NCHAR
  280.   If GR=1 Then Gosub GR_CONVERT
  281.   Locate N,M : Print I$; : Mid$(V$,N-N1+1,1)=I$ : If N<N1+MX Then Inc N
  282.   Right$(V$,1)=" "
  283. Goto NCHAR
  284. 'This is a converter to Greeks 
  285. 'Greek keyboard has many extra chars, located in 192 and up  
  286. GR_CONVERT:
  287. Data 192,193,214,195,196,212,194,198,200,205,201,202,203,204,206
  288. Data 207,81,208,209,210,199,215,87,213,211,197
  289. Data 216,218,249,220,221,247,219,224,227,235,231,232,233,234,236
  290. Data 238,113,239,240,242,226,250,241,248,243,223
  291. If I=59 or I=58 Then Gosub ME_TONO
  292. Restore GR_CONVERT
  293. For C=65 To 90 : Read A : If I=C Then I=A : I$=Chr$(I) : Goto EX1 Else Next 
  294. For C=97 To 122 : Read A : If I=C Then I=A : I$=Chr$(I) : Goto EX1 Else Next 
  295. EX1:
  296. Return 
  297. ME_TONO:
  298. Data 97,217,101,222,104,225,105,228,111,237,118,251,121,244
  299. C$=Input$(1) : C=Asc(C$)
  300. If I=58 and C=105 Then I=229 : I$=Chr$(I) : Return 
  301. If I=58 and C=121 Then I=245 : I$=Chr$(I) : Return 
  302. Restore ME_TONO : For I=1 To 7 : Read A,B : If A=C Then I=B : I$=Chr$(I)
  303. Next : If I$=";" Then I=C : I$=C$ : Return 
  304. Goto EX1
  305. ESC: MOV=27
  306. GO:
  307. Locate N,M : Paper 0 : Print Mid$(V$,N-N1+1,1);
  308. For I=MX To 1 Step -1 : If Mid$(V$,I,1)<>" " Then Exit 
  309. Next 
  310. V$=Left$(V$,I)
  311. End Proc